unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, Bass, ExtCtrls, Buttons;
type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Timer1: TTimer;
    TrackBar1: TTrackBar;
    bPass: TBitBtn;
    bFail: TBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure bPassClick(Sender: TObject);
    procedure bFailClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    sam: HSAMPLE;
    ch: HCHANNEL;
    procedure Error(msg: string);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  f: PChar;

implementation

{$R *.dfm}


procedure TForm1.Error(msg: string);
var
	s: string;
begin
	s := msg + #13#10 + '(Error code: ' + IntToStr(BASS_ErrorGetCode) + ')';
	MessageBox(Handle, PChar(s), nil, 0);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

  if ParamCount = 0 then bPass.Enabled := False;

  if not FileExists(paramStr(1)) then bPass.Enabled := False
  else
    f := PChar(ParamStr(1));

	if (HIWORD(BASS_GetVersion) <> BASSVERSION) then begin
		MessageBox(0,'An incorrect version of BASS.DLL was loaded',nil,MB_ICONERROR);
		Halt;
	end;

  if not BASS_Init(-1, 44100, 0, Handle, nil) then begin
    bPass.Enabled := False;
		Error('Error initializing audio!');
    Exit;
  end;

  sam := BASS_SampleLoad(FALSE, f, 0, 0, 3, BASS_SAMPLE_OVER_POS {$IFDEF UNICODE} or BASS_UNICODE {$ENDIF});

  if sam = 0 then begin
    bPass.Enabled := False;
    Error('Error loading sample');
    Exit;
  end;

  ch := BASS_SampleGetChannel(sam, False);
  BASS_ChannelFlags(ch, BASS_SAMPLE_LOOP, BASS_SAMPLE_LOOP);
  if not BASS_ChannelPlay(ch, False) then Error('Error playing sample!');

  TrackBar1.Max := BASS_ChannelGetLength(ch, BASS_POS_BYTE);
  Timer1.Enabled := True;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  TrackBar1.Position := BASS_ChannelGetPosition(ch, BASS_POS_BYTE);
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  BASS_ChannelSetPosition(ch, TrackBar1.Position,  BASS_POS_BYTE);
end;

procedure TForm1.bPassClick(Sender: TObject);
begin
  ExitCode := 0;
  Close;
end;

procedure TForm1.bFailClick(Sender: TObject);
begin
  ExitCode := 1;
  Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_SampleFree(sam);
end;

end.
